home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Whiteline: delta
/
whiteline CD Series - delta.iso
/
progtool
/
modula2
/
module
/
windowdi.mod
< prev
next >
Wrap
Text File
|
1995-11-25
|
10KB
|
286 lines
IMPLEMENTATION MODULE WindowDialogue;
FROM SYSTEM IMPORT WORD,VAL,ADDRESS,ADR,TSIZE,SHIFT;
FROM EasyWindow IMPORT rectangle,windowtype,RedrawProcType,wstring,
windowlist,WindowElements,
createWindow,WindowElement,openWindow,
closeWindow,deleteWindow;
FROM EasyDial IMPORT SetObjectXYWH,DoMoveDialog,GetObjectFlags,GetObjectTail,
WorkTree,TreePROC,GetBoxColor,GetObjectState,InitCheckBoxes,
FormKeyboard,FormButton,GetObjectXYWH;
FROM AES IMPORT ObjectDraw,FormCenter,EventMultiple,WindowFind,ObjectEdit,
WindowGet,ObjectFind,ApplWrite,WindowCalc,ApplTPlayback,
ObjectChange;
FROM GEMAESbase IMPORT MesageEvent,TimerEvent,KeyboardEvent,Editable,
WorkXYWH,Object,Crossed,Checked,Black,Selected,
ButtonEvent,Top,WCBorder,Default,TouchExit,Exit,
Selectable,GraphicButton;
FROM XBIOS104 IMPORT KeyTable,SetKeyTable, KeyTablePtr,KeyTrans,KeyTransPtr;
VAR DefaultObject,ButtonIndex,
SizeOfObj : INTEGER;
MessageBuffer : ARRAY [0..7] OF INTEGER;
ch : CHAR;
PROCEDURE and(a,b:WORD):BOOLEAN;
VAR c: BITSET;
BEGIN
c:=VAL(BITSET,a)*VAL(BITSET,b);
IF c<>VAL(BITSET,0) THEN RETURN TRUE
ELSE RETURN FALSE;
END(*IF*);
END and;
PROCEDURE FindLastButtonCapChar(TreePtr :ADDRESS; Index :INTEGER);
VAR Probe : POINTER TO Object;
s : POINTER TO ARRAY [0..40] OF CHAR;
j : INTEGER;
BEGIN
Probe:=TreePtr+VAL(ADDRESS, (Index*SizeOfObj));
IF (Probe^.type = GraphicButton)
AND and(Probe^.flags,Selectable) THEN
s:=Probe^.spec;
j:=-1;
REPEAT
j:= j+1
UNTIL (s^[j]=0C) OR (s^[j]=ch);
IF s^[j]#0C THEN
ButtonIndex:=Index;
END(*IF*);
END(*IF*);
END FindLastButtonCapChar;
PROCEDURE DrawWindowDial(window :INTEGER; r:rectangle);
VAR win : windowtype;
BEGIN
IF (windowlist[window]#NIL) THEN
win:=windowlist[window]^;
IF win.opened THEN
SetObjectXYWH(0,win.reference,win.work.x+1,win.work.y+1,win.work.w,win.work.h);
ObjectDraw(win.reference,0,8,r.x,r.y,r.w,r.h);
END(*IF*);
END(*IF*);
END DrawWindowDial;
PROCEDURE OpenWindowDial(TreePtr : ADDRESS;Title :ARRAY OF CHAR):INTEGER;
VAR Window :INTEGER;
OK : BOOLEAN;
r :rectangle;
BEGIN
Window:=CreateDialWindow(TreePtr,Title);
IF Window >0 THEN
OK:=OpenDialWindow(Window);
WindowGet(0,4,r.x,r.y,r.w,r.h);
DrawWindowDial(Window,r);
END(*IF*);
RETURN Window
END OpenWindowDial;
(*PROCEDURE FindExit(TreePtr:ADDRESS; Index:INTEGER);
VAR DiaObject : POINTER TO Object;
BEGIN
DiaObject:=TreePtr+ VAL(ADDRESS,(Index*SizeOfObj));
IF and(DiaObject^.flags,Exit) THEN
ExitObject:=Index;
END(*IF*);
END FindExit;*)
PROCEDURE FindDefault(TreePtr:ADDRESS; Index:INTEGER);
VAR DiaObject : POINTER TO Object;
BEGIN
DiaObject:=TreePtr+ VAL(ADDRESS,(Index*SizeOfObj));
IF and(DiaObject^.flags,Default) THEN
DefaultObject:=Index;
END(*IF*);
END FindDefault;
PROCEDURE DoWindowDial(ID, Window : INTEGER; TreePtr : ADDRESS;
EditObject :INTEGER):INTEGER;
CONST
ROOT =0;
MAXDEPTH=8;
EDINIT=1;
EDCHAR=2;
EDEND=3;
VAR pKeyTable :KeyTablePtr;
pKeyTa, KbdShift: KeyTransPtr;
VAR x,y,w,h :CARDINAL;
Play : ARRAY [0..3] OF INTEGER;
i,j,obj,mx,my,pos,button,cli,leave,event :INTEGER;
ExitObjectState :INTEGER;
msg : ARRAY [0..7] OF INTEGER;
SpKey,key,NewPos : INTEGER;
specstr,buffer : ADDRESS;
SeekButton : TreePROC;
IsDefault : TreePROC;
BEGIN
IF Window>0 THEN
DefaultObject:=-1;
IsDefault:=FindDefault;
WorkTree(TreePtr,0,0,IsDefault);
pKeyTa:=VAL(ADDRESS,-1);
pKeyTable:=SetKeyTable( pKeyTa, pKeyTa, pKeyTa);
KbdShift:=pKeyTable^.shift;
SeekButton:= FindLastButtonCapChar;
GetObjectXYWH(ROOT,TreePtr,x,y,w,h);
leave :=1;
IF EditObject>0 THEN
ObjectEdit(TreePtr,EditObject,0,pos,EDINIT,NewPos);
(* Cursor einschalten *)
END(*IF*);
WHILE leave>0 DO
event := EventMultiple(KeyboardEvent+ButtonEvent+MesageEvent+TimerEvent
,2,1,1,
0,0,0,0,0,0,0,0,0,0,
ADR(MessageBuffer),10000,0,(* Timer Event*)
mx,my,button,SpKey,key,cli);
pos := NewPos;
IF and(event,ButtonEvent) THEN
obj:=ObjectFind(TreePtr,ROOT,MAXDEPTH,mx,my);
IF obj >0 THEN
(* Ist es eine Checkbox ? *)
IF (GetObjectFlags(obj,TreePtr)=Selectable) AND
(GetObjectState(TreePtr,obj)=Checked+Selected) AND
(GetBoxColor(obj,TreePtr)=Black) THEN
ObjectChange(TreePtr,obj,0,x,y,w,h,Crossed+Selected,1);
ELSIF (GetObjectFlags(obj,TreePtr)=Selectable) AND
(GetObjectState(TreePtr,obj)=Crossed+Selected) AND
(GetBoxColor(obj,TreePtr)=Black) THEN
ObjectChange(TreePtr,obj,0,x,y,w,h, Checked+Selected,1);
(* Bei Editierbaren Feldern Cursor wechseln *)
ELSIF and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject) THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
EditObject:=obj;
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
ELSE
leave := FormButton(TreePtr,obj,cli,obj);
END(*IF*);
ELSIF obj < 0 THEN (* Maus wurde ausserhalb des Dialogs betätigt *)
IF EditObject>0 THEN
ObjectEdit(TreePtr,EditObject,0,pos,EDEND,NewPos);
END(*IF*); (* Cursor ausschalten ! *)
Play[0]:=0;
Play[1]:=1;
Play[2]:=cli;
Play[3]:=button;
(* Das Mausereignis nochmals erzeugen für Hauptapplikation *)
ApplTPlayback(ADR(Play),1,1);
RETURN 0
END(*IF*);
ELSIF and(event,MesageEvent) THEN
(* Der Applikation nochmals die message übergeben *)
ApplWrite(ID,16,ADR(MessageBuffer));
IF EditObject>0 THEN
ObjectEdit(TreePtr,EditObject,0,pos,EDEND,NewPos);
END(*IF*); (* Cursor ausschalten ! *)
RETURN 0
ELSIF and(event,TimerEvent) THEN
(* Do Nothing aber Hin Und wieder sollte ein Event auftreten *)
ELSIF and(event,KeyboardEvent) THEN
IF SpKey=08H THEN (* Alternate wurde gedrückt *)
ch:=CHR(VAL(INTEGER,KbdShift^[SHIFT(key,-8)]));
ButtonIndex:=-1;
WorkTree(TreePtr,0,0,SeekButton);
IF ButtonIndex #-1 THEN
(* Eintrag gefunden !! *)
leave := FormButton(TreePtr,ButtonIndex,1,obj);
END(*IF*);
ELSE
(* Return gedrückt und kein DEFAULT-Object? *)
IF (DefaultObject=-1) AND ((key =7181(*RETURN*))
OR (key=29197(*ENTER*))) THEN
(* In TAB-Taste umsetzen *)
key := 3849;(* TAB *)
END(*IF*);
leave:=FormKeyboard(TreePtr,EditObject,0,key,obj,SpKey);
IF SpKey >0 THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDCHAR,NewPos);
ELSE
IF and(GetObjectFlags(obj,TreePtr),Editable) AND (obj#EditObject)
AND (obj<=GetObjectTail(TreePtr,ROOT)) THEN
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
EditObject:=obj;
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDINIT,NewPos);
END(*IF*);
END(*IF*);
END(*IF*);
END(*IF*);
END(*WHILE*);
IF (EditObject>0) THEN
(* Cursor wieder ausschalten falls es Edit-Felder gab *)
ObjectEdit(TreePtr,EditObject,SpKey,pos,EDEND,NewPos);
END(*IF*);
RETURN obj
ELSE (* Es konnte kein Fenster erzeugt werden *)
RETURN DoMoveDialog(TreePtr,EditObject);
END(*IF*);
END DoWindowDial;
PROCEDURE CloseWindowDial(VAR Window : INTEGER);
BEGIN
IF Window>0 THEN
CloseDialWindow(Window);
DeleteDialWindow(Window);
END(*IF*);
END CloseWindowDial;
PROCEDURE CreateDialWindow(TreePtr : ADDRESS; TitleStr : ARRAY OF CHAR):INTEGER;
VAR win : windowtype;
x,y,w,h,xb,yb,wb,hb:INTEGER; window:INTEGER;
RedrawDial:RedrawProcType;
BEGIN
FormCenter(TreePtr,x,y,w,h);
InitCheckBoxes(TreePtr);
RedrawDial:=DrawWindowDial;
createWindow(window,x,y,w,h,WindowElements{Moveable,Title},TitleStr,TRUE,RedrawDial);
IF (windowlist[window]#NIL) THEN
win:=windowlist[window]^;
WindowCalc(WCBorder,VAL(INTEGER,WindowElements{Moveable,Title}),x,y,w,h,xb,yb,wb,hb);
win.min.x:=xb;
win.min.y:=yb;
win.min.w:=wb;
win.min.h:=hb;
win.snap:=TRUE;
win.reference:=TreePtr;
windowlist[window]^:=win;
END(*IF*);
RETURN window
END CreateDialWindow;
PROCEDURE OpenDialWindow(Window : INTEGER):BOOLEAN;
BEGIN
openWindow(Window,0,0,0,0);
END OpenDialWindow;
PROCEDURE CloseDialWindow(Window : INTEGER);
BEGIN
closeWindow(Window);
END CloseDialWindow;
PROCEDURE DeleteDialWindow(VAR Window : INTEGER);
BEGIN
deleteWindow(Window);
Window:=-1
END DeleteDialWindow;
BEGIN
SizeOfObj:=TSIZE(Object)
END WindowDialogue.